home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Languages / MS Cobol4.5 / DEMO / TICBUG.CBL < prev    next >
Text File  |  1991-04-08  |  10KB  |  239 lines
  1.       $set ans85 mf
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                     TICBUG.CBL                           *
  7.       *                                                          *
  8.       *    This program demonstrates how to debug a program.     *
  9.       *                                                          *
  10.       ************************************************************
  11.        identification division.
  12.            program-id. ticbug.
  13.        environment division.
  14.        configuration section.
  15.            source-computer. ibm-pc.
  16.            object-computer. ibm-pc.
  17.        special-names.
  18.            console is crt.
  19.        data division.
  20.        working-storage section.
  21.        01 tictac-00.
  22.         02 tictac-q.
  23.            03 game             pic x(10) value spaces.
  24.            03 filler-0         pic x(70) value spaces.
  25.            03 question         pic x(20) value spaces.
  26.         02 filler.
  27.            03 filler-1         pic x(414) value all spaces.
  28.            03 tictac-00-0735   pic x(17) value "7║      8║      9".
  29.            03 filler-2         pic x(64) value all spaces.
  30.            03 tictac-00-0836   pic x(09) value "║       ║".
  31.            03 filler-3         pic x(71) value all spaces.
  32.            03 tictac-00-0936   pic x(09) value "║       ║".
  33.            03 filler-4         pic x(64) value all spaces.
  34.            03 tictac-00-1029 pic x(23) value "═══════╬═══════╬═══════".
  35.            03 filler-5         pic x(63) value all spaces.
  36.            03 tictac-00-1135   pic x(17) value "4║      5║      6".
  37.            03 filler-6         pic x(64) value all spaces.
  38.            03 tictac-00-1236   pic x(09) value "║       ║".
  39.            03 filler-7         pic x(71) value all spaces.
  40.            03 tictac-00-1336   pic x(09) value "║       ║".
  41.            03 filler-8         pic x(64) value all spaces.
  42.            03 tictac-00-1429 pic x(23) value "═══════╬═══════╬═══════".
  43.            03 filler-9         pic x(63) value all spaces.
  44.            03 tictac-00-1535   pic x(17) value "1║      2║      3".
  45.            03 filler-10        pic x(64) value all spaces.
  46.            03 tictac-00-1636   pic x(09) value "║       ║".
  47.            03 filler-11        pic x(71) value all spaces.
  48.            03 tictac-00-1736   pic x(09) value "║       ║".
  49.            03 filler-12        pic x(595) value all spaces.
  50.        01 entry-array.
  51.            03 entry-char       pic x               occurs 9 times.
  52.        01 check-array.
  53.            03 check            pic s99     comp  occurs 9 times.
  54.        01 xcount               pic 9(2)    comp.
  55.        01 ocount               pic 9(2)    comp.
  56.        01 factor               pic s9(2)   comp.
  57.        01 char                 pic x.
  58.        01 char9 redefines char pic 9.
  59.        01 idx                  pic 9(2)    comp.
  60.        01 result               pic 9(2)    comp.
  61.        01 cursor-pos.
  62.            03 row              pic 9(2)    comp  value 99.
  63.            03 filler           pic 9(2)    comp  value 99.
  64.        01 address-init.
  65.            03 filler           pic 9(4)    value   1732.
  66.            03 filler           pic 9(4)    value   1740.
  67.            03 filler           pic 9(4)    value   1748.
  68.            03 filler           pic 9(4)    value   1332.
  69.            03 filler           pic 9(4)    value   1340.
  70.            03 filler           pic 9(4)    value   1348.
  71.            03 filler           pic 9(4)    value   0932.
  72.            03 filler           pic 9(4)    value   0940.
  73.            03 filler           pic 9(4)    value   0948.
  74.        01 address-array        redefines   address-init.
  75.            03 addr             pic 9(4)    occurs 9 times.
  76.        01 location             pic 9(4).
  77.        01 game-lines value     "147123311113332436978979".
  78.            03 a                pic 9       occurs 8 times.
  79.            03 b                pic 9       occurs 8 times.
  80.            03 c                pic 9       occurs 8 times.
  81.        01 i                    pic 9(2)    comp.
  82.        01 j                    pic 9(2)    comp.
  83.        01 moves                pic 9(2)    comp.
  84.  
  85.        78 clear-screen        value x"e4".
  86.        78 sound-bell          value x"e5".
  87.  
  88.        procedure division.
  89.        play-game section.
  90.        play-1.
  91.            perform with test after
  92.                until char not = "Y" and char not = "y"
  93.                call clear-screen
  94.                display
  95.                    "To select a square type a number between 1 and 9"
  96.                    upon crt
  97.                perform init
  98.                move "Shall I start ? " to question
  99.                perform get-reply
  100.                if char = "Y"
  101.                    move 10 to check(5)
  102.                    perform put-move
  103.                end-if
  104.                perform new-move until game not = spaces
  105.                move "Play again ?    " to question
  106.                perform get-reply
  107.            end-perform.
  108.  
  109.        play-stop.
  110.            stop run.
  111.  
  112.        get-reply section.
  113.            display tictac-q at 0201
  114.            accept char at 0317 with no-echo auto-skip
  115.            move spaces to question
  116.            display tictac-00 at 0201.
  117.  
  118.        init section.
  119.            move "y" to char
  120.            move spaces to entry-array
  121.            move low-values to check-array
  122.            move spaces to game
  123.            move zero to moves.
  124.  
  125.        new-move section.
  126.            perform get-move with test after until char9 not = 0
  127.            perform move-check
  128.            if game not = "stalemate"
  129.                move low-values to check-array
  130.                perform check-line varying i from 1 by 1
  131.                                until i > 8 or game not = spaces
  132.                if game not = "You win"
  133.                    perform put-move
  134.                end-if
  135.                if game = "I win" or game = "You win"
  136.                      perform varying idx from a(j) by b(j)
  137.                                                 until idx > c(j)
  138.                          move addr(idx) to location
  139.                          move entry-char(idx) to char
  140.                          display char at location with blink highlight
  141.                      end-perform
  142.                end-if
  143.            end-if.
  144.  
  145.        check-line section.
  146.            move zero to xcount,ocount,factor
  147.            perform count-up varying idx from a(i) by b(i)
  148.                                             until idx > c(i)
  149.            if ocount = 0 or xcount = 0
  150.                evaluate true
  151.                when ocount = 2
  152.                    if i = 4
  153.                        move 6 to j
  154.                        move zero to xcount,ocount
  155.                        perform count-up varying idx from a(j) by b(j)
  156.                                                 until idx > c(j)
  157.                        if xcount = 3
  158.                            move 6 to i
  159.                        end-if
  160.                    end-if
  161.                    if xcount not = 3
  162.                        move 50 to factor
  163.                        move "I win" to game
  164.                        move i to j
  165.                    end-if
  166.                when xcount = 2
  167.                    move 20 to factor
  168.                when ocount = 1
  169.                    move  4 to factor
  170.                when xcount = 1
  171.                    if entry-char(5) = "x"
  172.                        move  1 to factor
  173.                    else
  174.                        move -1 to factor
  175.                    end-if
  176.                when ocount = 0
  177.                    if xcount = 0
  178.                        move  2 to factor
  179.                    end-if
  180.                end-evaluate
  181.            end-if
  182.            if xcount = 3
  183.                move "You win" to game
  184.                move i to j
  185.            else
  186.                perform varying idx from a(i) by b(i) until idx > c(i)
  187.                    if entry-char(idx) = space
  188.                        add factor to check(idx)
  189.                    end-if
  190.                end-perform
  191.            end-if.
  192.  
  193.        count-up section.
  194.            if entry-char(idx) = "X"        add 1 to xcount
  195.            else if entry-char(idx) = "O"   add 1 to ocount.
  196.  
  197.        put-move section.
  198.            move zero to idx
  199.            move -99 to factor
  200.            perform find-pos varying i from 1 by 1 until i > 9
  201.            move "O" to entry-char(idx)
  202.            perform move-check.
  203.  
  204.        move-check section.
  205.            move addr(idx) to location
  206.            move entry-char(idx) to char
  207.            display char at location
  208.            add 1 to moves
  209.            if moves > 8 and game = spaces
  210.                move "stalemate" to game
  211.            end-if.
  212.  
  213.        find-pos section.
  214.            if entry-char(5) = space
  215.                move check(5) to factor
  216.                move 5 to idx
  217.            else
  218.                if check(i) not < factor and entry-char(i) = space
  219.                    move check(i) to factor
  220.                    move i to idx
  221.                end-if
  222.            end-if.
  223.  
  224.        get-move section.
  225.            display "Please select an empty square" at 0201
  226.            move 0 to char9
  227.            accept char9 at 0231 with auto-skip
  228.            if char9 = 0
  229.                call sound-bell
  230.            else
  231.                move char9 to idx
  232.                if entry-char(idx) = space
  233.                    move "X" to entry-char(idx)
  234.                else
  235.                    move 0 to char9
  236.                    call sound-bell
  237.                end-if
  238.            end-if.
  239.